home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / pipeq.zip / PIPEQ.FOR < prev    next >
Text File  |  1991-10-25  |  4KB  |  139 lines
  1. $include: 'flib.fi'
  2. $include: 'flib.fd'
  3.  
  4. implicit real (a-h),(o-z)
  5.  
  6.         character  dialog*80, ttitle*80, pname*7
  7. c
  8.         character p$type*5(25),fspec*35
  9. c
  10.         real*8  diam(25),plen(25),pvert(25),prough(25)
  11.         real*8  slope(25),slper(25),q(25),vel(25)
  12.         integer*2 d1(25),ilun
  13. c
  14.         ifile = 0
  15.         pi = 3.14159d0
  16.         istat = ABOUTBOXQQ('Pipe Flow Calculator \r Version 1.0'C)
  17.         ilun = 10
  18. c
  19.  10     open (UNIT = ilun, FILE = 'USER', TITLE = 'Pipe Chart Utility')
  20. c
  21.         dialog = 'Send results to ASCII file?'C
  22.         ttitle = 'File Status'C
  23.         istat = MESSAGEBOXQQ(dialog,ttitle,MB$YESNOCANCEL)
  24.         if (istat .eq. 0)go to 900
  25.         if (istat .eq. MB$IDYES) goto 20
  26.         if (istat .eq. MB$IDNO) go to 30
  27.         if (istat .eq. MB$IDCANCEL) go to 950
  28.  20     continue
  29.  21     format(a35)
  30.         ifile = 1
  31.         ilun = 20
  32.         iret = 1
  33.         open (UNIT = ilun, FILE = 'USER', TITLE = 'File Name Entry')
  34.         dummy = FOCUSQQ(ilun)
  35.  22     dialog = 'Enter file name:'
  36.         write(ilun,*)dialog
  37.         read(ilun,21,ERR = 700)fspec
  38.         open (UNIT = 30, FILE = fspec, STATUS = 'unknown',
  39.      +        access = 'sequential')
  40.         close(ilun)
  41. c
  42. c       Get user input
  43. c
  44.  30     continue
  45.         ilun = 10
  46.         iret = 2
  47.         dummy = FOCUSQQ(ilun)
  48.  34     dialog = 'How many pipes'
  49.         write(ilun,*)dialog
  50.         read(ilun,*,ERR = 700)ipnum
  51.         iret = 3
  52.         do 39 ip = 1, ipnum, 1
  53.  31     format('Pipe ',i2)
  54.  32     format(a5)
  55.  33     write(pname,31)ip
  56.         write(ilun,*)pname
  57.         dialog = 'Type of pipe (ex. CMP)?'
  58.         write(ilun,*)dialog
  59.         read(ilun,32,ERR = 700)p$type(ip)
  60.         dialog = 'Diameter of pipe (in.):'
  61.         write(ilun,*)dialog
  62.         read(ilun,*, ERR = 700)d1(ip)
  63.         diam(ip) = d1(ip)/12.0d0
  64.         dialog = 'Length of pipe (ft.):'
  65.         write(ilun,*)dialog
  66.         read(ilun,*,ERR = 700)plen(ip)
  67.         dialog = 'Vertical drop (ft.):'
  68.         write(ilun,*)dialog
  69.         read(ilun,*, ERR = 700)pvert(ip)
  70.         dialog = 'Roughness coeff.:'
  71.         write(ilun,*)dialog
  72.         read(ilun,*, ERR = 700)prough(ip)
  73. c
  74. c       Calcs
  75. c
  76.         ra = diam(ip) / 2.0d0
  77.         ax = pi * (ra**2)
  78.         rx = ax /(diam(ip)*pi)
  79.         slope(ip) = pvert(ip) / plen(ip)
  80.         slper(ip) = slope(ip) * 100
  81.         q(ip) = (1.486/prough(ip))*ax*(rx**(2.0d0/3.0d0))*
  82.      +         (slope(ip)**(1.0d0/2.0d0))
  83.         vel(ip) = q(ip) / ax
  84.  39     continue
  85. c
  86. c       Show it
  87. c
  88.  40     continue
  89. c
  90.  41     format('Pipe # ',i2,' Type: ',i3,'in. ',a5)
  91.  42     format('Length = ',f8.2,' ft.  Height = ',f8.2, ' Slope = ',
  92.      +          f6.2,'%')
  93.  43     format('Q (CFS) at full flow = ',f8.2)
  94.  44     format('Flow Velocity (Ft./Sec.) = ',f8.2)
  95.         ilun = 10
  96.         ilun3 = 30
  97.         do 49 ip = 1, ipnum, 1
  98.         write(dialog,41)ip,d1(ip),p$type(ip)
  99.         write(ilun,*)dialog
  100.         if (ifile .eq. 1) write(ilun3,*)dialog
  101.         write(dialog,42)plen(ip),pvert(ip),slper(ip)
  102.         write(ilun,*)dialog
  103.         if (ifile .eq. 1) write(ilun3,*)dialog
  104.         write(dialog,43)q(ip)
  105.         write(ilun,*)dialog
  106.         if (ifile .eq. 1) write(ilun3,*)dialog
  107.         write(dialog,44)vel(ip)
  108.         write(ilun,*)dialog
  109.         if (ifile .eq. 1) write(ilun3,*)dialog
  110.         dialog = ' '
  111.         write(ilun,*)dialog
  112.         if (ifile .eq. 1) write(ilun3,*)dialog
  113.  49     continue
  114.         dialog = 'Pipe Chart Finished'C
  115.  50     open (UNIT = ilun, FILE = 'USER', TITLE = dialog)
  116.         dialog = 'Do another?'C
  117.         ttitle = 'Decision time'C
  118.         istat = MESSAGEBOXQQ(dialog,ttitle,MB$YESNOCANCEL)
  119.         if (istat .eq. 0)go to 900
  120.         if (istat .eq. MB$IDYES) goto 10
  121.         if (istat .eq. MB$IDNO) go to 950
  122.         if (istat .eq. MB$IDCANCEL) go to 950
  123.  700    continue
  124. c
  125.         dialog = 'Keyboard entry error'
  126.         write(ilun,*)dialog
  127.         goto (22,34,33)iret
  128.  850    continue
  129.         dialog = 'File opening error'
  130.         write(ilun,*)dialog
  131.         go to 950
  132.  900    continue
  133.         dialog = 'Memory allocation error'
  134.         write(ilun,*)dialog
  135.  950    continue
  136.         end
  137.  
  138.  
  139.